perm filename DRAW.OLD[DRW,LCS]1 blob sn#396832 filedate 1978-11-19 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C***** FOLLOWING IS FILE 'DRAW.CMD' **********
C00013 ENDMK
C⊗;
C***** FOLLOWING IS FILE 'DRAW.CMD' **********
C***	DRAW[DRW,LCS],MSSIO[NEW,LCS],CB[DRW,LCS]
C***	,DRAWSM[DRW,LCS],DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
C***	,CURSOR[MSS,LCS],SUBSLM[DRW,LCS]

C  'G' OR <CR> = GET.  'A'=ADD TO COMBINED FILE.
C PC=PLOT  PX=XGP(→PLOT.BIN)  PXS,PCS=PLOT SMOOTHED CONTURE
C  PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
C  F=JUMP AND BEGIN FILL SECTION.  FX=EXIT AND FILL ALL.
C SINGLE ITEM IS RESTRICTED TO 350 WDS. 10 ITEMS OR 350 WDS PER FILE.
C  'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
	COMMON /RC/MCLEF(400),IST(4000)
	COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
	COMMON/ZN/SCLEF(400,2),DDD /ED/KED,NEXT,NN,NX,NY,J
	COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
	DIMENSION JCLEF(10),KCLEF(10),NMLST(10),JST(1)
	COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,IPLT,RJB,CENTR
	EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST(1490)),(NM,IXRX)
	1 ,(GRID,IST(4000)),(KCLEF,IST(1500))
	1 ,(NMLST,IST(1510)),(JST,IST(500))
	DATA RJB/-20./,CENTR/-26./
	RSZ=0
1	MCLEF(1)=0
	MM=0
	IPLT=0
	IPLTX=-1
	K=1
91	TYPE 100
55	FORMAT(I,2F)
50	FORMAT(3A1)
	XSZ=RSZ
	ACCEPT 55,J,RSZ,GRID
	IF(RSZ.EQ.0)RSZ=XSZ
	MORE=-1
	REREAD 50,N,JC,JS
	IF(N.EQ.' ')GO TO 91
C PXS,PCS=SMOOTH ONLY;  PXZ,PCZ=SMOOTH AND FILL
C  TO SAVE SIZE FACTOR WHEN REDRAWING.
	IF(N.EQ.'Z')GO TO 1
	IF(RSZ.EQ.0)RSZ=9.0
	IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
	IF(N.EQ.'M'.OR.N.EQ.'R')GO TO 192
	IF(N.EQ.'V')CALL CNVT
C  V=CONVERT FROM OLD FORMAT TO NEW.
C  FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
	IF(N.EQ.'F')GO TO 79
C  FILLS IT.
	IF(JS.EQ.'L')N='Z'
C  DEL=DELETE FROM COMB. FILE.   (JS='L')
	IF(N.EQ.'C'.OR.N.EQ.'A'.OR.N.EQ.'Z')GO TO 999
CC	IF(N.EQ.'X')CALL EXIT
	IF(N.EQ.'Q')GO TO 56
C  'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
	IF(N.NE.'D'.AND.N.NE.'E')GO TO 191
CC	IF(JC.EQ.'X')MCLEF(1)=0
C  TYPE 'DX' TO START NEW DRAWING WITHOUT EXIT. (GOOD AFTER 'Q')

	KED=N
	MM=MCLEF(1)
	IF(MM.NE.0)GO TO 92
C  ADD TO DRAWING?
	GO TO 3

56	CALL POG2
	CALL RDRAW(2,MCLEF(1),MCLEF)
	CALL DPYOUT(2)
	CALL POG1
	GO TO 91
999	CALL CMBN
	GO TO 111
CC192	IF(N.EQ.'R')MCLEF(1)=-MCLEF(1)
192	CALL SHIFT(MCLEF(2),MCLEF(1),N)
	J=1
	JC=0
	GO TO 333
291	FORMAT(A2,A5)
191	REREAD 291,NM,NM
	IF(NM.NE.' ')GO TO 293
	TYPE 41
	IF(JC.EQ.'M')GO TO 194
	IF(N.EQ.'S')GO TO 194
	MCLEF(1)=0
	MM=0
	IPLTX=-1
	K=1
194	IF(JC.EQ.'M')MORE=0
	JQ=JC
	JC=0
	JM=1
	IF(MCLEF(1).EQ.0)GO TO 193
CC	JC=JCLEF(2)-1
CC	JM=MCLEF(1)+1
	JM=MCLEF(1)+1
193	ACCEPT 10,NM,PASS
	IF(NM.EQ.' ')NM=LASTNM
	IF(NM.EQ.' ')GO TO 91
	IF(NM.EQ.'99')GO TO 91
C  '99'  WILL BACKUP
293	IF(N.NE.'S')LASTNM=NM
CC	REWIND 1
	IF(N.EQ.'S')GO TO 40
	IF(LOOKF(NM).EQ.0)GO TO 191
C  'FAIL' ROUTINE TO CHECK ON LOOKUP
CC	CALL IFILE(1,NM)
CC	READ(1,5)M,JCLEF
	CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
C  -1=READ
C  CAN'T USE 'GM' WITH 'COMBINED' FILE.
CC	JQ=0
CC	IF(MORE.EQ.0.AND.JCLEF(3).NE.0)JQ=JM-1
	J=1
	IF(KCLEF(2).EQ.0)GO TO 290
CC	IF(PASS.NE.0)CALL ITEM
	TYPE 1100
	ACCEPT 55,J
	J=J+1
C  ITEMS ARE NUMBERED  0 THROUGH 9 (10 ITEMS).
	IF(J.GT.10)GO TO 191
CC290	IC=KCLEF(K+1)-KCLEF(K)
290	IC=KCLEF(J)+JST(KCLEF(J))-1
CC	IF(J.EQ.10)IC=1000
	TYPE 110,IC
	IF(IC.GT.350)TYPE 1110
60	JZ=1
	IF(MORE.EQ.0)JZ=JM
	L=KCLEF(J)-1
	M=JST(L+1)+JZ-1
	IF(MORE.NE.0)GO TO 161
	M=M-1
	L=L+1
161	DO 61 K=JZ,M
	L=L+1
CJ	M=K
61	MCLEF(K)=JST(L)
	MCLEF(1)=M
1100	FORMAT(' ITEM NUM?'/)
700	FORMAT(' RESET X-Y POS. ',$)
555	FORMAT(2F)
7	IF(MORE)GO TO 70
	DO 771 K=2,JM-1
771	IF(MCLEF(K).GE.200000000)GO TO 772
	GO TO 70
C PUTS FILLER TO END
C  MOVES OUTLINE UP FRONT
772	M=MCLEF(1)
	DO 773 L=K,JM
	M=M+1
773	MCLEF(M)=MCLEF(L)
CJ	K=MJ+K
	K=JM-K  
1774	DO 774 L=JM,M
774	MCLEF(L-K)=MCLEF(L)
	GO TO 3

70	IF(N.NE.'P')GO TO 3
	IXRX=-1
	IF(JQ.NE.'X')IXRX=0
C 0=SEND IT TO CALCOMP
	TYPE 700
	ACCEPT 555,X,Y
	IF(X.NE.0)RJB=X/RSZ
	IF(Y.NE.0)CENTR=Y/RSZ
C  TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
	IF(IPLTX)CALL PLOTS(0)
C  DO I NEED THIS?
	IF(GRID.GT.0)CALL GRIDS
	IPLTX=0
	IPLT=-1
3	IF(N.NE.'D')MM=0
C  RESET IF NOT GOING TO DRAWIT
333	IF(N.EQ.'P')GO TO 337
	CALL DPYSET(1,IST,4000)
	CALL DPYBRT(4)
	NIST=IST(2)
	IF(N.GE.0)GO TO 337
	IF(N.EQ.'G')GO TO 337
	IF(N.EQ.'M')GO TO 337
	IF(N.NE.'R')GO TO 92
CC337	JJ=MCLEF(1)
337	IF(JS.EQ.'Z')GO TO 306
	IF(JS.NE.'S')GO TO 338
	CALL SMOOTH(JS)
	GO TO 436
338	IC=-1
	MM=1
	DO 335 K=2,MCLEF(1)
	IF(MCLEF(K).LT.200000000)GO TO 335
CC	CALL DPYBRT(3)
CC	CALL RDRAW(K,MCLEF(1),MCLEF)
CC	CALL DPYOUT(1)
CC	CALL DPYBRT(4)
CC	JJ=K-1
	IC=K
	GO TO 334
C FOR 1ST LOC. OF MCLEF IN FILLER
335	CONTINUE
334	CALL RDRAW(2,MCLEF(1),MCLEF)
	CALL DPYOUT(1)
	NIST=IST(2)
CC	IF(JJ.EQ.MCLEF(1))GO TO 436
	GO TO 436
C NO FILLER
79	IF(IC)GO TO 91
C  IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
CJ	TYPE 336
CJ	ACCEPT 10,J
	JZ=N
CC	IF(J.NE.'Y'.AND.J.NE.'S')GO TO 436
	KK=0
CJ	IF(J.NE.'Y')GO TO 206
	IF(JC.NE.'S')GO TO 206
C  TYPE 'FS' TO FILL AND SMOOTH
CC	IF(J.NE.'S')GO TO 206
306	CALL SMOOTH(0)
C  SMOOTHS AND FILLS
	GO TO 436
206	RR=RSZ
	DO 205 J=IC,MCLEF(1)
	CALL UNPACK(J,M,N,MCLEF)
	KK=KK+1
	NF(KK)=0
	IF(LL.GE.100000000)NF(KK)=3
	QF(KK)=(M+RJB)*RR
205	RF(KK)=(N+CENTR)*RR
	NF(1)=KK
	CALL FILLQ(QF,RF,NF)
436	IF(JZ.EQ.'P')CALL PLOT(0,0,3)
	GO TO 91

66	TYPE 666,NM
	GO TO 91
666	FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
336	FORMAT(' SMOOTH? ',$)
10	FORMAT(A5,F)
5	FORMAT(12I)
100   FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/'
	1 P=PLOT, PX=XGP, A=ADD TO SAVED FILE
	1, DEL=DEL. FROM FILE, Q=BACKGROUND, Z=ZERO DRAWING'/
	1' F=FILL,  E=EDIT,   N1=SIZE, N2=1=GRID '/)
C  N1=20 TO CHANGE SHAPE

92	IST(2)=NIST
	CALL DRAWIT
  	N=0
	GO TO 3

403	FORMAT(' WRITE OVER ',A5,'.DMD?  ',$)
41	FORMAT(' TYPE FILE NAME'/)
C  SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
40	IF(LOOKF(NM).EQ.0)GO TO 402
	TYPE 403,NM
	ACCEPT 50,K
	IF(K.EQ.'N')GO TO 191
CC402	IC=MCLEF(1)+1
402	NMLST(1)=NM
	JCLEF(1)=1
	DO 1111 K=2,10
	JCLEF(K)=0
1111	NMLST(K)=' '
	CALL RDSAV(JCLEF,NMLST,MCLEF(1),NM,MCLEF,0)
	NQ=MCLEF(1)
CC	CALL OFILE(1,NM)
CC	WRITE(1,120),IC
CC	CALL SAVE(MCLEF)
CC	WRITE(1,1111)NM
CC1111	FORMAT(' 9999 ',A5)
111	TYPE 110,NQ
	IF(NQ.GT.350)TYPE 1110
CC	END FILE(1)
CC	TYPE 1111,NM
	GO TO 91
CC120	FORMAT(' 9999  1 ',I4,' 0 0 0 0 0 0 0 0')
110	FORMAT(' TOTAL WDS=',I3)
1110	FORMAT(' ********************************',/
	1      ' ***** WARNING - LIMIT=350 ******',/
	1      ' ********************************')
	END